home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / amsf20.zip / AMST4.FOR < prev    next >
Text File  |  1992-01-06  |  2KB  |  48 lines
  1. C     ******************************************************************
  2. C     *                                                                *
  3. C     *                         S O L V E                              *
  4. C     *                                                                *
  5. C     ******************************************************************
  6.       PROGRAM  SOLVE
  7.       IMPLICIT INTEGER*4(I-N)
  8.       IMPLICIT REAL*8 (A-H,O-Z)
  9.       REAL*4   EPS
  10.       CHARACTER ANS*1
  11.       COMMON   MAVAIL,IA(30000)
  12.       MAVAIL = 30000
  13. C ... SOLVE SIMULTANEOUS LINEAR EQUATIONS AX=B
  14.       PRINT *,' '
  15.       PRINT *,'SIMULTANEOUS LINEAR EQUATIONS SOLVER:  A X = B'
  16.       PRINT *,' '
  17.       PRINT *,'ENTER NUMBER OF EQUATIONS ? '
  18.       READ  *, N
  19.       MODE = 0
  20.       PRINT *,'IS MATRIX A SYMMETRIC <Y/N> ?'
  21.       READ  '(A)',ANS
  22.       IF (ANS.EQ.'Y'.OR.ANS.EQ.'y') MODE=1
  23. C ... TEST IN-CORE DATA MANAGEMENT
  24.       CALL DBOPEN(1,'TSTDAT.DAT','NEW')
  25.       CALL DEFINE(1,'A',0,1,N,N,MODE,NA)
  26.       CALL DEFINE(1,'B',0,1,N,1,0,NB)
  27.       PRINT *,'NOW ENTER THE MATRIX A'
  28.       CALL MATINP(1,'A')
  29.       PRINT *,'NOW ENTER THE RIGHT-HAND-SIDE VECTOR B'
  30.       CALL MATINP(1,'B')
  31. C ... SOLVE BY IBM SSP ROUTINES DGELG AND DGELS
  32.       EPS = 1.0E-7
  33.       IF (MODE.EQ.0) THEN
  34.          CALL DGELG(IA(NB),IA(NA),N,1,EPS,INFO)
  35.       ELSE
  36.          CALL DEFINE(1,'AUX',0,1,N-1,1,0,IAUX)
  37.          CALL DGELS(IA(NB),IA(NA),N,1,EPS,INFO,IA(IAUX))
  38.       ENDIF
  39.       IF (INFO.NE.0) THEN
  40.          PRINT *,INFO,'-TH PIVOT IS ZERO.'
  41.          STOP
  42.       ENDIF
  43.       PRINT *,'THE SOLUTION VECTOR X'
  44.       CALL MATOUT(1,'B')
  45.       CALL DBCLOS(1,'DELETE')
  46.       STOP 'DONE.'
  47.       END
  48.